﻿Imports System
Imports System.IO
Imports System.Text
Imports System.Net
Imports Microsoft.Win32
Imports System.Runtime.InteropServices

Public Class daTianShi
    Const need_ver = "5.1423"                                                                                               '预注册的漠漠版本号
    Const dm_regcode = "cnlanlansky23361f7ae180cfca6d192a5ac2bb029f"            '漠漠VIP账号
    Const dm_verinfo = "lingyu"                                                                                            '漠漠版本附加信息
    Const ini_filename = "dtstool.ini"
    Const id_filename = "id_card5000.txt"           '身份证文件名
    Const cn_filename = "cnname.txt"                  '保存中文名字拼音的文件名
    Const english_filename = "english-name.txt" '保存英文名字的文件名
    Const SetFindWidth = 1024
    Const SetFindHeight = 768
    Const dama2datianshiID = "e0578d4966dc83b3ea8320798be03c26"   '打码兔软件ID
    Const yzm91sn = "pYySAwVHg1lNYjgC"     '91验证码打码序列号
    Const INTERNET_OPTION_END_BROWSER_SESSION = 42

    Private dm As mycx     '定义dm为漠漠对象
    Private mm As mm_diy '定义mm为自定义功能对象
    Private HwndStart, HwndLogin, HwndPlaying                       '【启动窗口:HwndStart   登录窗口:HwndLogin   游戏窗口:HwndPlaying】
    '  Private ImgArr() As  Hashtable       '返回找图各个字段【ImgArr("id")=图片id, ImgArr("x")=x坐标, ImgArr("y")=y坐标】
    '  Private StrArr()   As  Hashtable     '返回等字各个字段【StrArr("id")=文字id, StrArr("x")=x坐标, StrArr("y")=y坐标】
    Private rootPath As String = Application.StartupPath & "\"          '程序所在主目录
    Private imgPath As String = rootPath & "\Resources\"                  '程序附件所在目录
    Private iniFilePath As String = rootPath & ini_filename                 '配置文件路径
    Private baseDmPath As String = imgPath                                          '漠漠插件,字体所在目录,等同于程序附件所在目录
    Private gamePath As String                  '游戏执行文件路径
    Private oldCookiePath As String         '执行程序前注册表中cookies路径的值
    Private newCookiePath As String = rootPath & "temp\"       '执行程序时设置的新 cookies路径的值
    Private chromePath As String   'Chrome浏览器路径
    Private connString As String            '保存数据库连接信息 :　　例如"Server=127.0.0.1;Database=lingyu;Uid=francisjohn;Pwd=2988070;charset=utf8"
    Private dbServerIp As String              '游戏数据库服务器IP
    Private dbUser As String                            '数据库用户名
    Private dbName As String                         '数据库名字
    Private dbPasswd As String                      '数据库密码
    Private isLogStart                                   '是否开启日志
    Private dama2User As String            '打码兔用户名
    Private dama2Pwd As String      '打码兔密码
    ' Private mmDatiIp As String                   '内网答题IP
    Private myIpAddress As String  '本机IP地址
    Private LocalHostName As String     '本机机器名

    '●●●●●●●●●●●●●●●●●●●●●●●●●●●脚本开始●●●●●●●●●●●●●●●●●●●●●●●●●●●

    '引用的标准控件
    '枫骚易语言写的POST注册
    <DllImport("Resources\epost.dll", EntryPoint:="register37wanAccount", SetlastError:=True)>
    Private Shared Function register37wanAccount(regName As String, regPwd As String, idName As String, idNumber As String, yzm91sn As String, yzmPath As String) As Boolean
    End Function

    <DllImport("Resources\epost.dll", EntryPoint:="registerBaiduAccount", SetlastError:=True)>
    Private Shared Function registerBaiduAccount(regName As String, regPwd As String, idName As String, idNumber As String) As Boolean
    End Function

    <DllImport("Resources\epost.dll", EntryPoint:="login37Check", SetlastError:=True)>
    Private Shared Function login37Check(loginName As String, loginPwd As String, yzm91sn As String, yzmPath As String) As Boolean
    End Function

    <DllImport("wininet.dll", SetlastError:=True)>
    Private Shared Function InternetSetOption(hInternet As IntPtr, ByVal dwOption As Integer, ByVal lpBuffer As IntPtr, ByVal lpdwBufferLength As Integer) As Boolean
    End Function

    <DllImport("user32.dll", EntryPoint:="MessageBoxA", SetlastError:=True)>
    Private Shared Function myMsgBox(hWnd As IntPtr, msg As String, caption As String, type As IntPtr) As Integer
    End Function

    '数据操作函数
    Private Function dbUpdateRecord(userName, platform, fildName, fildValue) As Boolean
        Dim oneUser As New Hashtable
        Dim counts As Integer = 0
        Dim mydb As New mySqlDB(connString)
        Dim queryresult As String = ""
        Dim sql As String
        Try
            sql = "update user_datianshi set user_datianshi." & fildName & "='" & fildValue & "' where user_datianshi.user_name='" & userName & "' and user_datianshi.platform ='" & platform & "'"
            counts = mydb.executeDMLSQL(sql, queryresult)
            If counts = 1 And queryresult = "SUCCESS" Then
                Console.WriteLine("成功更新账号: " & userName & " 的字段(" & fildName & " )为: " & fildValue & " !")
                Return True
            End If
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function '更新 userName 的字段  fildName 值为 fildValue

    Private Function dbInsertRecord(userName As String, userPwd As String, platform As String, Optional idName As String = "", Optional idNumber As String = "", Optional area As String = "") As Boolean
        Dim oneUser As New Hashtable
        Dim counts As Integer = 0
        Dim mydb As New mySqlDB(connString)
        Dim queryresult As String = ""
        Dim sql As String
        Try
            sql = " INSERT INTO `user_datianshi` (`user_name`, `user_pwd`, `platform`, `idcard_name`, `idcard_number`,`area`) VALUES ('" & userName & "', '" & userPwd & "', '" & platform & "', '" & idName & "', '" & idNumber & "', '" & area & "')"
            counts = mydb.executeDMLSQL(sql, queryresult)
            If counts = 1 And queryresult = "SUCCESS" Then
                Console.WriteLine("成功插入新用户: " & userName & " 密码:" & userPwd & "平台:" & platform & " 身份证: " & idName & "身份证号:" & idNumber & "游戏区号:" & area)
                Return True
            Else
                Console.WriteLine("账号添加失败! 请检查数据库中是否存在此账号!")
            End If
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function '插入一条新的记录 

    Private Function dbDeleteRecord(userName As String, platform As String) As Boolean
        Dim oneUser As New Hashtable
        Dim counts As Integer = 0
        Dim mydb As New mySqlDB(connString)
        Dim queryresult As String = ""
        Dim sql As String
        Try
            sql = " delete from  `user_datianshi`  where `user_name`='" & userName & "' and  `platform`='" & platform & "'"
            counts = mydb.executeDMLSQL(sql, queryresult)
            If counts = 1 And queryresult = "SUCCESS" Then
                Console.WriteLine("成功删除用户: " & userName & "平台:" & platform)
                Return True
            Else
                Console.WriteLine("删除 " & platform & " 平台账号: " & userName & " 失败! 请检查数据库中是否存在此账号!")
            End If
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function '删除一条记录 

    Private Function dbExportOneAccount(ByRef oneAccount As Hashtable, ByVal platform As String) As Boolean
        Dim oneUser As New Hashtable
        Dim counts As Integer = 0
        Dim mydb As New mySqlDB(connString)
        Dim queryresult As String = ""
        Dim sql As String
        Try
            '首先优先查找之前first_ip字段等于本机IP地址的机器, 状态为离线 以及可接受任务不等于空的账户
            sql = "select * from user_datianshi where user_datianshi.platform ='" & platform & "' and user_datianshi.area=''  limit 1"
            oneUser = mydb.getOneRecord(sql, queryresult, counts)

            '如果找到一条记录的话, 设置账号的状态为 "登录" 状态,并且返回找到的账户
            If counts = 1 And queryresult = "SUCCESS" Then
                Console.WriteLine("找到可用于" & oneUser("platform") & "平台导出的账户: " & oneUser("user_name"))
                oneAccount = oneUser
                Return True
            Else
                Console.WriteLine("找不到可用导出的账号, 请检查该平台未导出账号是否为空! ")
            End If
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function '获得一条账号

    Private Function dbGetAccountInfo(ByRef oneAccount As Hashtable, ByVal userName As String, ByVal platform As String) As Boolean
        Dim oneUser As New Hashtable
        Dim counts As Integer = 0
        Dim mydb As New mySqlDB(connString)
        Dim queryresult As String = ""
        Dim sql As String
        Try
            sql = "select * from user_datianshi where user_datianshi.platform ='" & platform & "' and user_datianshi.user_name='" & userName & "'  limit 1"
            oneUser = mydb.getOneRecord(sql, queryresult, counts)
            If counts = 1 And queryresult = "SUCCESS" Then
                Console.WriteLine("查询到" & oneUser("platform") & "平台账户: " & oneUser("user_name") & "信息")
                oneAccount = oneUser
                Return True
            Else
                Console.WriteLine("查询不到 " & platform & " 平台用户名为: " & userName & " 的信息!")
            End If
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function '查询制定平台的某一条账号记录信息

    Private Function dbGetMultiUser(ByRef multiUser As ArrayList, ByVal platform As String, Optional ByVal gameArea As String = "", Optional ByVal huanzi As String = "") As Boolean
        Dim users As ArrayList
        Dim counts As Integer = 0
        Dim mydb As New mySqlDB(connString)
        Dim queryresult As String = ""
        Dim sql As String
        Try
            '首先优先查找之前first_ip字段等于本机IP地址的机器, 状态为离线 以及可接受任务不等于空的账户
            sql = "select * from user_datianshi where user_datianshi.platform ='" & platform & "'"
            If gameArea <> "" Then
                If gameArea = "*" Then
                    sql = sql & " and user_datianshi.area<>''"
                Else
                    sql = sql & " and user_datianshi.area='" & gameArea & "'"
                End If
            End If
            If huanzi <> "*" Then
                sql = sql & " and user_datianshi.huanzi='" & huanzi & "'"
            End If

            users = mydb.getMultiRecord(sql, queryresult, counts)
            '如果找到一条一条以上的记录
            If counts > 0 And queryresult = "SUCCESS" Then
                Console.WriteLine("找到" & platform & "平台可操作的账户总数: " & counts & " 条")
                multiUser = users
                Return True
            Else
                Console.WriteLine("找不到符合条件的账号, 请检查该平台未导出账号是否为空! ")
            End If
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function '获得多条数据库记录, 通过arraylist类型的 multiUser变量将找到的数据传回

    Private Function dbGetMultiRecords(ByRef multiRecords As ArrayList, ByVal sql As String) As Boolean
        Dim users As ArrayList
        Dim counts As Integer = 0
        Dim mydb As New mySqlDB(connString)
        Dim queryresult As String = ""
        Try
            '首先优先查找之前first_ip字段等于本机IP地址的机器, 状态为离线 以及可接受任务不等于空的账户
            users = mydb.getMultiRecord(sql, queryresult, counts)
            '如果找到一条一条以上的记录
            If counts > 0 And queryresult = "SUCCESS" Then
                Console.WriteLine("查询到记录数: " & counts & " 条")
                multiRecords = users
                Return True
            Else
                Console.WriteLine("找不到符合条件记录! 请检查sql语句是否正确! ")
            End If
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function '获得多条数据库记录, 通过arraylist类型的 multiUser变量将找到的数据传回



    '软件初始以及常用函数
    Private Sub daTianShi_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        'Console.WriteLine(getTimeStamp(Now))
        Dim mhandle As IntPtr = Me.Handle()
        Console.WriteLine("辅助工具窗口句柄:" & mhandle.ToString)
        If Not (init()) Then
            Console.WriteLine("程序初始化错误,请检查日志! ")
        End If
    End Sub

    Private Function init() As Boolean  '程序初初始化操作, 释放资源文件,注册漠漠插件,读取配置文件,读取账号, 如果有错误则返回false
        '获得注册表信息,创建临时cookies保存路径
        Dim reg As RegistryKey = Registry.CurrentUser
        Dim shellFolders As RegistryKey = reg.OpenSubKey("SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", True)
        If Not (Directory.Exists(newCookiePath)) Then
            Directory.CreateDirectory(newCookiePath)
        End If
        oldCookiePath = shellFolders.GetValue("Cookies")
        '获取本机IP地址
        LocalHostName = System.Net.Dns.GetHostName
        myIpAddress = getMyIP(LocalHostName)
        lblLocalIP.Text = "本机IP: " & myIpAddress
        connString = ""
        '初始化漠漠插件
        Console.WriteLine("当前程序所在目录:" & rootPath)
        If Not (File.Exists(imgPath & "sky.dll")) Then    '判断sky.dll是否存在,不存在则报错退出初始化
            MsgBox("程序初始化失败! 找不到sky.dll")
            Return False
        End If
        If regDm(dm_regcode, dm_verinfo) Then   '尝试注册漠漠,如果注册成功则继续初始化
            dm.SetPath(baseDmPath)
            dm.SetDict(0, "font.txt")
            dm.SetShowErrorMsg(0)
            If readini() Then                                        '读取配置文件
                Console.WriteLine("读取配置文件成功!")
            Else
                Console.WriteLine("读取配置文件失败! 请查看日志!")
                Return False
            End If
            If dbServerIp <> "" And dbName <> "" And dbUser <> "" And dbPasswd <> "" Then
                connString = "Server=" & dbServerIp & ";DataBase=" & dbName & ";Uid=" & dbUser & ";Pwd=" & dbPasswd & ";charset=utf8"
            End If
        Else
            Console.WriteLine(" 漠漠注册失败!!,检查相关文件!")
            Return False
        End If
        Return True
    End Function

    Private Function readini() As Boolean   '读取配置文件函数
        Try  '如果配置文件不存在的话,尝试创建配置文件, 创建失败函数退出返回 false
            If Not (File.Exists(iniFilePath)) Then
                Dim fs As FileStream = File.Create(iniFilePath)   '创建配置文件
                'Dim info As Byte() = New UTF8Encoding(True).GetBytes("This is some text in the file.")  '得先做转换
                'fs.Write(info, 0, info.Length)        '这是filestrem类写入内容的方法
                fs.Close()   '通过file.create方法创建的文件默认是打开的,如果想让别的程序能操作就得先关闭文件
            Else
                gamePath = dm.ReadIni("base", "gamePath", iniFilePath)
                dbServerIp = dm.ReadIni("base", "mysqlServerIp", iniFilePath)
                dbName = dm.ReadIni("base", "dbName", iniFilePath)
                dbUser = dm.ReadIni("base", "dbUser", iniFilePath)
                dbPasswd = dm.ReadIni("base", "dbPasswd", iniFilePath)
                dama2User = dm.ReadIni("base", "dama2User", iniFilePath)
                dama2Pwd = dm.ReadIni("base", "dama2Pwd", iniFilePath)
                chromePath = dm.ReadIni("base", "chromePath", iniFilePath)

                'mmDatiIp = dm.ReadIni("base", "mmDatiIp", iniFilePath)

                txtMysqlIp.Text = dbServerIp
                txtDama2User.Text = dama2User
                txtDama2Pwd.Text = dama2Pwd
                'txtDbName.Text = mmDatiIp
                txtDbName.Text = dbName
                txtDbUserName.Text = dbUser
                txtDbPasswd.Text = dbPasswd
                txtChromePath.Text = chromePath
            End If

        Catch ex As Exception
            Console.WriteLine(ex)
            Return False
        End Try
        Return True
    End Function

    Private Function saveini() As Boolean    '保存配置文件函数
        Try  '
            If File.Exists(iniFilePath) Then
                If txtMysqlIp.Text <> "" And txtDama2User.Text <> "" And txtDama2Pwd.Text <> "" And txtDbName.Text <> "" And txtDbPasswd.Text <> "" And txtChromePath.Text <> "" Then
                    dbServerIp = txtMysqlIp.Text
                    dama2User = txtDama2User.Text
                    dama2Pwd = txtDama2Pwd.Text
                    dbName = txtDbName.Text
                    dbUser = txtDbUserName.Text
                    dbPasswd = txtDbPasswd.Text
                    chromePath = txtChromePath.Text
                    'mmDatiIp = txtDbName.Text
                    dm.WriteIni("base", "mysqlServerIP", dbServerIp, iniFilePath)
                    dm.WriteIni("base", "dbName", dbName, iniFilePath)
                    dm.WriteIni("base", "dbUser", dbUser, iniFilePath)
                    dm.WriteIni("base", "dbPasswd", dbPasswd, iniFilePath)
                    dm.WriteIni("base", "dama2User", dama2User, iniFilePath)
                    dm.WriteIni("base", "dama2Pwd", dama2Pwd, iniFilePath)
                    dm.WriteIni("base", "chromePath", chromePath, iniFilePath)
                    'dm.WriteIni("base", "mmDatiIp", mmDatiIp, iniFilePath)
                Else
                    MsgBox("请正确填写配置信息,所有字段均不能为空!")
                End If

            Else
                MsgBox("配置文件" & iniFilePath & " 不存在! 请检查文件!")
                Return False
            End If
        Catch ex As Exception
            Console.WriteLine(ex)
            Return False
        End Try
        Return True
    End Function

    Private Function regDm(ByVal dm_regcode As String, ByVal dm_verinfo As String) As Boolean
        Dim ver As String, oldDmPath As String, testDmVip As Integer
        'Console.WriteLine(ws)
        Shell("regsvr32 atl.dll /s") ' 插件需要用到atl系统库,有些XP精简系统会把atl.dll精简掉. 为了防止注册失败，这里手动注册一下atl.dll
        Shell("regsvr32 " & baseDmPath & "Dama2.dll  /s")
        'Shell("regsvr32 " & basePath & "sky.dll  /u /s")
        Shell("regsvr32 " & baseDmPath & "sky.dll  /s")
        Delay(500)
        dm = New mycx   '创建漠漠对象
        ver = dm.Ver
        If ver <> need_ver Then  '判断预注册版本和当前版本是否一致
            If ver <> "" Then '判断是否得到版本信息,及sky.dll是否注册成功
                oldDmPath = dm.GetBasePath() '得到系统已经注册的sky.dll的路径
                dm = Nothing
                Shell("regsvr32 " & oldDmPath & "sky.dll  /u /s") '卸载系统已经注册的sky.dll
                Delay(200)
                ver = ""
                dm = New mycx '再次创漠漠对象
                ver = dm.Ver()
                If ver = "" Then
                    Console.WriteLine("卸载成功")
                Else
                    MsgBox("卸载失败,当前版本为:【" & ver & "】,路径:【" & dm.GetBasePath() & "】")
                    Return False
                End If
            End If
            Shell("regsvr32 " & baseDmPath & "sky.dll  /s")  '注册指定版本
            Delay(500)
            ver = ""
            dm = New mycx '卸载成功后再次创建漠漠对象
            ver = dm.Ver()
            If ver <> need_ver Then
                MsgBox("初始化,当前漠漠版本为:【" & ver & "】,路径:【" & dm.GetBasePath() & "】")
                Return False
            End If
        End If
        Console.WriteLine("漠漠版本: " & ver)
        testDmVip = dm.Reg(dm_regcode, dm_verinfo) '开始注册收费功能.
        Select Case testDmVip
            Case -1
                Console.WriteLine("无法连接网络,(可能防火墙拦截,如果可以正常访问大漠插件网站，那就可以肯定是被防火墙拦截)")
            Case -2
                Console.WriteLine("进程没有以管理员方式运行. (出现在win7 win8 vista 2008.建议关闭uac")
            Case 0
                Console.WriteLine("失败(未知错误)")
            Case 1
                Console.WriteLine("漠漠VIP注册成功!")
            Case 2
                Console.WriteLine("余额不足")
            Case 3
                Console.WriteLine("绑定了本机器，但是账户余额不足50元.")
            Case 4
                Console.WriteLine(": 注册码错误")
            Case 5
                Console.WriteLine(": 你的机器或者IP在黑名单列表中或者不在白名单列表中.")
            Case 6
                Console.WriteLine(": 非法使用插件.")
            Case 7
                Console.WriteLine(": 你的帐号因为非法使用被封禁.")
            Case -8
                Console.WriteLine(": 版本附加信息长度超过了10()")
            Case -9
                Console.WriteLine(": 版本附加信息里包含了非法字母.")
        End Select
        If testDmVip <> 1 Then
            MsgBox("漠漠VIP注册失败! 请检查日志!")
            Return False
        End If
        Return True
    End Function

    Private Function getMyIP(ByVal hostName As String) As String
        Dim ipEntry = System.Net.Dns.GetHostEntry(hostName)
        Dim i As Integer, ipAddress As String
        For i = 0 To ipEntry.AddressList.Length - 1
            Console.WriteLine(ipEntry.AddressList(i).ToString)
            If ipEntry.AddressList(i).AddressFamily = Net.Sockets.AddressFamily.InterNetwork Then
                ipAddress = ipEntry.AddressList(i).ToString
                Return ipAddress
            End If
        Next
        Return ""
    End Function     '得到本机IP地址

    Private Function Random(ByVal Min, ByVal Max) As Integer
        Dim result As Integer
        Randomize()
        result = Int((Max - Min + 1) * Rnd() + Min)
        Return result
    End Function  '随机函数

    Private Sub Delay(ByVal Interval As Double)  'Interval单位为毫秒
        Dim time As DateTime = DateTime.Now
        Dim Span As Double = Interval * 10000  '因为时间是以100纳秒为单位
        While ((DateTime.Now.Ticks - time.Ticks) < Span)
            Application.DoEvents()
        End While
    End Sub

    Private Sub btnSaveini_Click_1(sender As Object, e As EventArgs) Handles btnSaveini.Click
        If saveini() Then
            MsgBox("配置保存成功!")
            readini()  '重新读取配置文件
        Else
            MsgBox("配置保存失败!请检查日志!")
        End If
    End Sub

    Private Sub daTianShi_closed(sender As Object, e As System.EventArgs) Handles MyBase.Closed
        Dim reg As RegistryKey = Registry.CurrentUser
        Dim shellFolders As RegistryKey = reg.OpenSubKey("SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", True)
        shellFolders.SetValue("Cookies", oldCookiePath)   '恢复注册表Cookies 值
        dm = Nothing
    End Sub

    Private Function getRandName(ByVal nameDictArr, ByRef preRegisterName, ByRef preRegisterPwd) As Boolean    '从传入的用户名字典数组中随机取一个账户, 附加4位随机数
        Dim userName As String, userPwd As String, i As Integer
        Dim randNum As Integer
        Dim uperString, lowString, symbolString, intString, substring
        userName = ""
        '随机取出一个用户名,附加4位随机数后总账户名字不超过20位
        Do While userName = ""
            userName = nameDictArr(Random(0, UBound(nameDictArr) - 1))
            randNum = Random(1000, 9999)
            substring = Mid(userName, 1, 10)
            userName = substring & randNum.ToString
            If userName.Length > 14 Then
                userName = ""
            End If
        Loop
        '随机产生一个10位数的密码, 组合数字,大小写字母,特殊字符, 1位大些,4位小写,3-4位数字, 
        userPwd = ""
        uperString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" : lowString = "abcdefghijklmnopqrstuvwxyz" : symbolString = "~_~" : intString = "0123456789"
        userPwd = Mid(uperString, Random(1, 26), 1)
        For i = 1 To 5
            userPwd = userPwd & Mid(lowString, Random(1, 26), 1)
        Next
        For i = 1 To Random(3, 5)
            userPwd = userPwd & Mid(intString, Random(1, 10), 1)
        Next
        Dim lowandint As String = lowString & intString
        preRegisterPwd = Replace(userPwd, Mid(lowandint, Random(1, 36), 1), Mid(symbolString, Random(1, 3), 1))
        preRegisterName = userName
        Return True
    End Function

    Private Function getRandIDcard(ByVal idCards, ByRef idName, ByRef idNumber) As Boolean  '从传入身份证数组中随机取一条记录,返回身份证名字和身份证号
        Dim idRecord, idArr
        idRecord = idCards(Random(0, UBound(idCards) - 1))
        idArr = Split(idRecord, "|")
        idName = idArr(0) : idNumber = idArr(1)
        Return True
    End Function

    Private Function findImg(ByVal imgName, ByRef imgx, ByRef imgy) As Integer
        Dim x, y, dm_ret
        Dim i As Integer
        For i = 1 To 30
            dm_ret = dm.FindPic(0, 0, 1024, 768, imgName, "000000", 0.7, 0, x, y)
            If dm_ret <> -1 Then
                Exit For
            End If
            dm.Delay(1000)
        Next
        imgx = x : imgy = y
        Return dm_ret
    End Function

    Private Sub Lclick(ByVal x, ByVal y)
        dm.MoveTo(x, y)
        dm.Delay(200)
        dm.LeftClick()
    End Sub

    Private Sub backSpace()
        For i = 1 To 20 '随机按15到20次 退格键
            dm.KeyPress(8)
            dm.Delay(20)
        Next
    End Sub

    Private Function dama2(ByVal picPath As String) As String
        Dim dama As Dama2Lib.IDama2Ctrl = New Dama2Lib.Dama2Ctrl
        Dim result As String
        Dim resultArr
        result = dama.D2File3(dama2datianshiID, dama2User, dama2Pwd, picPath, 60, 42)  '返回的结果类似: 1762463832,5MQF , 需要分割处理
        resultArr = Split(result, ",")
        Console.WriteLine("打码结果:" & resultArr(1))
        Return resultArr(1)
    End Function

    Private Function openChrome() As Boolean   '打开Chrome浏览器,并且返回chrome浏览器的窗口句柄
        Dim hwnd, dm_ret
        hwnd = dm.FindWindowSuper("打开新的标签页 - Google Chrome", 0, 0, "Chrome_WidgetWin_1", 2, 0)
        If hwnd <> 0 Then     '检查chrome是否打开,
            Console.WriteLine(hwnd)
        Else
            dm.RunApp("chrome.exe", 1)
            For i = 1 To 5
                dm.Delay(1000)
                hwnd = dm.FindWindowSuper("打开新的标签页 - Google Chrome", 0, 0, "Chrome_WidgetWin_1", 2, 0)
                If hwnd <> 0 Then
                    Console.WriteLine("Chrome浏览器窗口句柄:　" & hwnd)
                    Exit For
                End If
            Next
            If hwnd = 0 Then
                MsgBox("超过5秒未打开chrome, 请检查chrome是否正确安装")
                Return False
            End If
        End If
        dm_ret = dm.UnBindWindow()  '先解除dm窗口绑定
        'dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows3", "windows", "", 0)  '后台绑定chrome窗口
        dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows3", "normal", "", 0)
        If dm_ret = 1 Then
            dm_ret = dm.SetWindowSize(hwnd, SetFindWidth, SetFindHeight)
            If dm_ret = 0 Then
                MsgBox("设置chrome窗口大小失败!请检查设置!")
                Return False
            End If
        Else
            MsgBox("Chrome窗口绑定失败,请检查设置")
            Return False
        End If
        Return True
    End Function

    Private Sub clearChrome()
        Dim dm_ret, imgx, imgy, dm_leave, leaveX, leaveY
        copydata(846, 57, "chrome://settings/clearBrowserData")  '输入选中平台的注册账号地址
        dm.Delay(200)
        dm.KeyPress(13)
        dm.Delay(500)
        dm_leave = dm.FindPic(0, 0, 1024, 768, "chrome离开页面.bmp|chrome离开页面边框未选中.bmp", "000000", 0.8, 0, leaveX, leaveY)
        Console.WriteLine("chrome离开页面坐标:" & dm_leave & " " & leaveX & " " & leaveY)
        If dm_leave <> -1 Then
            Lclick(550, 195)
        End If
        dm.Delay(1000)
        dm_ret = dm.FindPic(0, 0, 1024, 768, "chrome清除缓存图片.bmp", "000000", 0.8, 0, imgx, imgy)
        If dm_ret <> -1 Then
            Lclick(293, 406)
            dm.Delay(500)
        End If
        Lclick(635, 578)
        Lclick(633, 565)
        dm.Delay(500)
        For i = 1 To 20
            dm_ret = dm.FindPic(0, 0, 1024, 768, "chrome清除浏览数据.bmp", "000000", 0.8, 0, imgx, imgy)
            dm.Delay(1000)
            If dm_ret = -1 Then
                Exit For
            End If
        Next
        Lclick(846, 57)    '移动到地址输入栏
        backSpace()
    End Sub

    Private Function getTimeStamp(ByVal dt As DateTime) As String
        Dim ts As TimeSpan
        ts = dt.ToUniversalTime() - New DateTime(1970, 1, 1, 0, 0, 0, 0)
        Return Convert.ToInt64(ts.TotalMilliseconds).ToString()
    End Function


    Private Sub registerByHttp(ByVal platformCode, ByVal platformUrl)
        Dim preRegisterName As String, preRegisterPwd As String
        Dim hwnd, dm_ret
        Dim i, idCards, idRecord, idName, idNumber, idArr, count
        Dim imgx, imgy
        Dim nameDictArr
        Dim registerNum As Integer

        If Not (openChrome()) Then
            MsgBox("打开Chrome浏览器失败!")
            dm.UnBindWindow()
            Exit Sub
        End If
        nameDictArr = File.ReadAllLines(imgPath & cn_filename)  '读取账号名字典
        idCards = File.ReadAllLines(imgPath & id_filename)   '读取身份证字典
        registerNum = CInt(txtRegisterNum.Text) '总共要注册的账号数量
        Console.WriteLine("总共要注册的账号数量:" & registerNum)

        For count = 1 To registerNum
            getRandName(nameDictArr, preRegisterName, preRegisterPwd)  '取一条账户新信息,以及生成随机密码
            Console.WriteLine("用户名: " & preRegisterName & "密码:" & preRegisterPwd)
            getRandIDcard(idCards, idName, idNumber)  '取一条身份证记录
            Console.WriteLine(idName & " : " & idNumber)

            copydata(846, 57, platformUrl)    '复制链接到地址栏
            dm.Delay(100)
            dm.KeyPress(13)
            dm.Delay(1000)
            Dim dm_findimg As Boolean = False
            Select Case platformCode
                Case "360"
                    dm_findimg = waitImg("360首页注册按钮.bmp", imgx, imgy)  '找图,等首页注册按钮刷新出来
                Case "百度"
                    dm_findimg = waitImg("百度快速注册按钮.bmp", imgx, imgy)
            End Select
            Console.WriteLine("首页注册按钮坐标:" & dm_ret & "," & imgx & "," & imgy)
            dm.Delay(200)
            If dm_findimg Then
                Select Case platformCode
                    Case "360"
                        Lclick(120, 340)
                        dm.Delay(1000)
                        dm_ret = findImg("360马上注册按钮.bmp", imgx, imgy)  '找图 马上注册页面
                        Console.WriteLine("马上注册按钮坐标:" & dm_ret & "," & imgx & "," & imgy)
                        If dm_ret <> -1 Then
                            Dim dm_yzm, inputx, inputy, dm_inputok, yzmx, yzmy, dm_err, errx, erry, dm_user, userx, usery
                            Dim yzmErr As Integer = 0
                            dm_inputok = -1
                            dm_yzm = -1
                            dm_user = -1
                            Do
                                If dm_inputok = -1 Or dm_user <> -1 Then
                                    getRandName(nameDictArr, preRegisterName, preRegisterPwd)  '取一条账户新信息,以及生成随机密码
                                    Console.WriteLine("用户名: " & preRegisterName & "密码:" & preRegisterPwd)
                                    Lclick(645, 280)
                                    backSpace() : dm.Delay(200)
                                    dm.KeyPressStr(preRegisterName, 50)
                                    dm.Delay(50)
                                    Lclick(645, 344)
                                    backSpace() : dm.Delay(200)
                                    dm.KeyPressStr(preRegisterPwd, 50)
                                    dm.Delay(50)
                                    Lclick(645, 402)
                                    backSpace() : dm.Delay(200)
                                    dm.KeyPressStr(preRegisterPwd, 50)
                                    dm.Delay(50)
                                    Lclick(687, 448)
                                    dm.Delay(200)
                                    dm.Delay(2000)
                                End If
                                dm_err = dm.FindPic(0, 0, 1024, 768, "360请正确填写注册码.bmp|360验证码错误.bmp", "000000", 0.8, 0, errx, erry)
                                '如果验证码错误的话或者没有输入验证码
                                If dm_err <> -1 Then
                                    dm.Delay(4000)
                                    dm.CaptureJpg(508, 450, 607, 485, imgPath & "login_360yzm.jpg", 50)  '将验证码截图置于imgPath目录下
                                    Dim yzm As String = dama2(imgPath & "login_360yzm.jpg")
                                    Lclick(489, 464)
                                    backSpace() : dm.Delay(200)
                                    dm.KeyPressStr(yzm, 50)
                                    dm.Delay(200)
                                End If
                                '出现验证码和不出现验证码按钮位置不同
                                If dm_yzm = -1 Then
                                    Lclick(480, 480)
                                Else
                                    dm_ret = dm.FindPic(0, 0, 1024, 768, "360马上注册按钮.bmp", "000000", 0.7, 0, imgx, imgy)
                                    If dm_ret <> -1 Then
                                        Lclick(481, 543)
                                    End If
                                End If
                                dm.Delay(200)
                                For i = 1 To 10
                                    dm_inputok = dm.FindPic(0, 0, 1024, 768, "360输入正确.bmp", "000000", 0.8, 0, inputx, inputy)
                                    dm.Delay(100)
                                    dm_yzm = dm.FindPic(0, 0, 1024, 768, "360注册验证码.bmp", "000000", 0.9, 0, yzmx, yzmy)
                                    dm.Delay(100)
                                    dm_user = dm.FindPic(0, 0, 1024, 768, "360用户名被使用.bmp", "000000", 0.9, 0, userx, usery)
                                    dm.Delay(100)
                                    If dm_inputok = -1 Or dm_yzm <> -1 Or dm_user <> -1 Then
                                        Exit For
                                    End If
                                    dm.Delay(1000)
                                Next
                                ' dm_ret = findImg("360免费注册.bmp", imgx, imgy)  '找图 马上注册页面
                            Loop Until dm_inputok = -1

                            dm_ret = findImg("360身份证确定.bmp", imgx, imgy)  '找图 马上注册页面
                            If dm_ret <> -1 Then
                                Dim dm_register
                                dm_err = 0
                                Do
                                    If dm_err = 0 Then
                                        getRandIDcard(idCards, idName, idNumber)  '取一条身份证记录
                                        '输入身份证名字
                                        dm.SetClipboard(idName) ' 身份证名字放到剪切板,用来后面粘贴
                                        Lclick(647, 407)
                                        backSpace()
                                        dm.Delay(500)
                                        dm.KeyDown(17)               '按下Ctrl键
                                        Delay(100)
                                        dm.KeyPress(86)               '键入V键
                                        Delay(100)
                                        dm.KeyUp(17)                  '松开 Ctrl键   完成CTRL+ V 粘贴过程
                                        dm.Delay(200)
                                        '输入身份证号
                                        Lclick(647, 470)
                                        backSpace()
                                        dm.Delay(200)
                                        dm.KeyPressStr(idNumber, 50)
                                        dm.Delay(200)
                                        Lclick(680, 537)
                                        dm.Delay(200)
                                        Lclick(470, 540)
                                        dm.Delay(500)
                                    End If
                                    dm_err = dm.FindPic(0, 0, 1024, 768, "360身份证错误.bmp", "000000", 0.8, 0, errx, erry)
                                    Console.WriteLine("身份证验证结果: " & dm_err)
                                    dm.Delay(500)
                                    dm_register = dm.FindPic(0, 0, 1024, 768, "360免费注册.bmp", "000000", 0.8, 0, imgx, imgy)
                                    Console.WriteLine("360免费注册按钮:", dm_ret)
                                Loop Until dm_err = -1 And dm_register = -1  '如果身份证信息有错或者为空, 并且蓝色免费注册字样消失
                                '身份证信息正确提交以后,将用户记录插入数据库中
                                If dbInsertRecord(preRegisterName, preRegisterPwd, platformCode, idName, idNumber) Then
                                    tboxOutput.AppendText("成功插入新用户: " & preRegisterName & " 密码:" & preRegisterPwd & " 身份证: " & idName & "身份证号:" & idNumber & "游戏区号:" & vbCrLf)
                                Else
                                    tboxOutput.AppendText("账号添加失败! 请检查数据库中是否存在此账号!" & vbCrLf)
                                End If
                                '清除浏览器Cookies
                                clearChrome()
                            Else
                                MsgBox("超过30秒未正确提交身份证信息!")
                            End If

                        Else
                            MsgBox("超过30秒未找到马上注册按钮! ")
                        End If
                        '360注册账号结束

                    Case "百度"
                        If imgx <> -1 And imgy <> -1 Then  '有时候会出现,能找到图片,但是获取不到图片坐标,暂时用点击固定坐标解决
                            Lclick(imgx + 2, imgy + 2)
                        Else
                            Lclick(360, 520)
                        End If
                        dm.Delay(1000)
                        Dim dm_loginsoon, loginsoonX, loginsoonY, dm_sfz, buttonsfzX, buttonsfzY
                        dm_loginsoon = findImg("百度立即注册按钮.bmp", loginsoonX, loginsoonY)  '找图 马上注册页面
                        Console.WriteLine("百度立即注册按钮坐标:" & dm_loginsoon & "," & loginsoonX & "," & loginsoonY)
                        If dm_loginsoon <> -1 Then
                            Dim dm_yzm, yzmx, yzmy, dm_err, errx, erry, dm_touxiang, touxiangX, touxiangY
                            Dim yzmErr As Integer = 0
                            dm_yzm = -1
                            dm_touxiang = -1

                            Dim nameOK As Boolean = False
                            For i = 1 To 10
                                getRandName(nameDictArr, preRegisterName, preRegisterPwd)  '取一条账户新信息,以及生成随机密码
                                Console.WriteLine("用户名: " & preRegisterName & "密码:" & preRegisterPwd)
                                copydata(380, 260, preRegisterName)  '输入用户名
                                dm.Delay(100)
                                Lclick(380, 310)  '点击一下密码输入框, 如果用户名重复则会出现 用户名重复提示
                                dm.Delay(100)
                                dm_err = dm.FindPic(0, 0, 1024, 768, "百度用户名被使用.bmp", "000000", 0.8, 0, errx, erry)
                                If dm_err = -1 Then
                                    Console.WriteLine("用户名:" & preRegisterName & " 可以正常注册!")
                                    nameOK = True
                                    Exit For
                                Else
                                    Console.WriteLine("用户名:" & preRegisterName & "重复,尝试再次输入用户名!")
                                End If
                            Next
                            If Not (nameOK) Then
                                Console.WriteLine("尝试输入用户次数超过十次!")
                                Exit Select
                            End If
                            copydata(380, 310, preRegisterPwd)  '输入密码
                            dm.Delay(100)
                            copydata(380, 360, preRegisterPwd)  '重复密码
                            dm.Delay(200)
                            If loginsoonX <> -1 And loginsoonY <> -1 Then
                                Lclick(loginsoonX + 5, loginsoonY + 5)  '点击立即注册按钮,有时候找图获取不到坐标,暂时用点击固定坐标解决
                            Else
                                Lclick(220, 465)
                            End If

                            dm.Delay(500)
                            If Not (waitImg("百度注册后头像.bmp", touxiangX, touxiangY)) Then
                                Console.WriteLine("超过30秒没有找到用户默认的头像! 退出当前账号注册, 请检查浏览器!")
                                Exit Select
                            End If

                            copydata(846, 57, "youxi.baidu.com/user_center.xhtml?c=realNameVerify")
                            dm.Delay(200)
                            dm.KeyPress(13)
                            dm.Delay(1000)

                            If Not (waitImg("百度身份证确定.bmp", buttonsfzX, buttonsfzY, 282, 186, 980, 655)) Then
                                Console.WriteLine("超过30秒没有找到输入身份证确定按钮!")
                                Exit Select
                            Else
                                Console.WriteLine("百度提交身份证确定按钮坐标: " & buttonsfzX & "  " & buttonsfzY)
                            End If
                            dm_err = 0
                            Do
                                If dm_err <> -1 Then '如果没有错误则不需要再次输入新的身份证
                                    getRandIDcard(idCards, idName, idNumber)  '取一条身份证记录
                                    Console.WriteLine("身份证名字:" & idName, " 身份证号码: ", idNumber)
                                    copydata(575, 330, idName)
                                    dm.Delay(100)
                                    Lclick(575, 370)
                                    dm.Delay(100)
                                    copydata(575, 370, idNumber)
                                    dm.Delay(100)
                                End If
                                If buttonsfzX <> -1 And buttonsfzY <> -1 Then
                                    Lclick(buttonsfzX + 2, buttonsfzY + 2)  '单击确定按钮
                                Else
                                    Lclick(405, 405)
                                End If

                                dm.Delay(1000)
                                dm_err = dm.FindPic(282, 186, 980, 655, "百度身份证号码错误.bmp|百度身份证名字错误.bmp", "000000", 0.8, 0, errx, erry)
                                Console.WriteLine("身份证验证错误结果: " & dm_err)
                                dm.Delay(500)
                                dm_sfz = dm.FindPic(282, 186, 980, 655, "百度身份证确定.bmp", "000000", 0.8, 0, buttonsfzX, buttonsfzY)
                                Console.WriteLine("百度防沉迷认证提交按钮:", dm_sfz, "  " & buttonsfzX & "  " & buttonsfzY)
                            Loop Until dm_err = -1 And dm_sfz = -1  '直到输入身份证信息没有错误, 并且蓝色免费注册消失
                            '等待提交身份证认证后返回页面
                            If waitImg("百度通过实名认证.bmp", imgx, imgy) Then
                                '身份证信息正确提交以后,将用户记录插入数据库中
                                If dbInsertRecord(preRegisterName, preRegisterPwd, platformCode, idName, idNumber) Then
                                    tboxOutput.AppendText("成功插入新用户: " & preRegisterName & " 密码:" & preRegisterPwd & " 身份证: " & idName & "身份证号:" & idNumber & "游戏区号:" & vbCrLf)
                                Else
                                    tboxOutput.AppendText("账号添加失败! 请检查数据库中是否存在此账号!" & vbCrLf)
                                End If
                            Else
                                Console.WriteLine("提交身份证实名认证后,等待返回页面超时!")
                            End If

                            '清除浏览器Cookies
                            clearChrome()

                        Else
                            MsgBox("超过30秒未找到马上注册按钮! ")
                        End If
                        '百度注册账号结束

                End Select

            Else
                MsgBox("超过30秒没有找到首页注册按钮!")
            End If
        Next  '循环注册账号结束
        dm.UnBindWindow()
    End Sub

    Private Sub registerByPost(ByVal platformCode)  '未完成
        Dim preRegisterName As String, preRegisterPwd As String
        Dim i, idCards, idRecord, idName, idNumber, idArr, count
        Dim nameDictArr
        Dim registerNum As Integer

        nameDictArr = File.ReadAllLines(imgPath & cn_filename)  '读取账号名字典
        idCards = File.ReadAllLines(imgPath & id_filename)   '读取身份证字典
        registerNum = CInt(txtRegisterNum.Text) '总共要注册的账号数量
        Console.WriteLine("总共要注册的账号数量:" & registerNum)

        For count = 1 To registerNum
            getRandName(nameDictArr, preRegisterName, preRegisterPwd)  '取一条账户新信息,以及生成随机密码
            Console.WriteLine("用户名: " & preRegisterName & "密码:" & preRegisterPwd)
            getRandIDcard(idCards, idName, idNumber)  '取一条身份证记录
            Console.WriteLine(idName & " : " & idNumber)
            Select Case platformCode
                Case "百度"
                    Console.WriteLine("注册账号信息,账户名:" & preRegisterName & "账户密码: " & preRegisterPwd & "身份证名字:" & idName & "身份证号码:" & idNumber)
                    'Console.WriteLine("注册结果" & registerBaiduAccount(preRegisterName, preRegisterPwd, idName, idNumber))
                    If registerBaiduAccount(preRegisterName, preRegisterPwd, idName, idNumber) Then
                        If dbInsertRecord(preRegisterName, preRegisterPwd, platformCode, idName, idNumber) Then
                            tboxOutput.AppendText("成功插入新用户: " & preRegisterName & " 密码:" & preRegisterPwd & " 身份证: " & idName & "身份证号:" & idNumber & "游戏区号:" & vbCrLf)
                        Else
                            tboxOutput.AppendText("账号添加失败! 请检查数据库中是否存在此账号!" & vbCrLf)
                        End If
                    Else
                        Console.WriteLine("账号注册失败!可能账号已经被注册!")
                    End If

                Case "37wan"
                    Console.WriteLine("注册账号信息,账户名:" & preRegisterName & "账户密码: " & preRegisterPwd & "身份证名字:" & idName & "身份证号码:" & idNumber)
                    'Console.WriteLine("注册结果" & register37wanAccount(preRegisterName, preRegisterPwd, idName, idNumber, "pYySAwVHg1lNYjgC"))
                    If register37wanAccount(preRegisterName, preRegisterPwd, idName, idNumber, yzm91sn, imgPath) Then
                        If dbInsertRecord(preRegisterName, preRegisterPwd, platformCode, idName, idNumber) Then
                            tboxOutput.AppendText("成功插入新用户: " & preRegisterName & " 密码:" & preRegisterPwd & " 身份证: " & idName & "身份证号:" & idNumber & "游戏区号:" & vbCrLf)
                        Else
                            tboxOutput.AppendText("账号添加失败! 请检查数据库中是否存在此账号!" & vbCrLf)
                        End If
                    Else
                        Console.WriteLine("账号注册失败!可能账号已经被注册!或者验证码识别失败!")
                    End If
            End Select
            dm.Delay(Random(1000, 3000))
        Next

    End Sub

    Private Sub btnStartRegister_Click(sender As Object, e As EventArgs) Handles btnStartRegister.Click
        Dim platformUrl As String, platformCode As String
        Dim registerMethod As String

        platformUrl = "" : platformCode = ""
        registerMethod = "POST"
        For Each selectRadio As RadioButton In grpPlatform.Controls
            If selectRadio.Checked Then
                Select Case selectRadio.Text
                    Case "百度"
                        'platformUrl = "youxi.baidu.com"
                        platformUrl = "youxi.baidu.com/login.xhtml?toURL=http%3A%2F%2Fyouxi.baidu.com%2Fuser_center.xhtml"
                        platformCode = "百度"
                    Case "360"
                        platformUrl = "wan.360.cn"
                        platformCode = "360"
                    Case "37"
                        platformUrl = "my.37.com/register.html"
                        platformCode = "37wan"
                    Case "YY"
                        platformUrl = "aq.yy.com/p/reg/account.do?appid=1&action=3&busiurl=https%3A%2F%2Faq.yy.com&fromadv="
                        platformCode = "多玩"
                End Select
            End If
        Next
        Select Case platformCode

            Case "360"
                registerByHttp(platformCode, platformUrl)
            Case "百度"
                If registerMethod = "HTTP" Then
                    registerByHttp(platformCode, platformUrl)
                Else
                    registerByPost(platformCode)
                End If
            Case "37wan"
                registerByPost(platformCode)

        End Select

        '使用Chrome浏览器模拟手工注册结束

    End Sub


    Private Sub btnExportAccount_Click(sender As Object, e As EventArgs) Handles btnExportAccount.Click
        Dim oneAccount As New Hashtable
        Dim accountPlatform, accountAreaArr, exportNum, exportPlatform
        Dim areaCounts As Integer, i As Integer, groupCount As Integer, j As Integer
        Dim exportFilePath As String
        Dim oneUser As String
        exportPlatform = cbxExportPlatform.GetItemText(cbxExportPlatform.SelectedItem)
        accountAreaArr = Split(txtGameArea.Text, "|")
        If Not (Directory.Exists(rootPath & "exportfile")) Then
            Directory.CreateDirectory(rootPath & "exportfile")
        End If

        If txtGameArea.Text <> "" Then
            exportNum = CInt(txtExportNum.Text)
            groupCount = exportNum / (UBound(accountAreaArr) + 1)
            Console.WriteLine("导出平台:" & exportPlatform & "每个游戏区账号数:" & groupCount)
            exportFilePath = rootPath & exportPlatform & "平台" & Now.ToString("yMMddHHmm") & "导出账号.txt"
            tboxOutput.AppendText("导出文件路径: " & exportFilePath)
            If Not (File.Exists(exportFilePath)) Then
                Dim fs As FileStream = File.Create(exportFilePath)   '创建导出文件
                'Dim info As Byte() = New UTF8Encoding(True).GetBytes("This is some text in the file.")  '得先做转换
                'fs.Write(info, 0, info.Length)        '这是filestrem类写入内容的方法
                fs.Close()   '通过file.create方法创建的文件默认是打开的,如果想让别的程序能操作就得先关闭文件
            End If
            For i = 0 To UBound(accountAreaArr)
                For j = 1 To groupCount

                    If dbExportOneAccount(oneAccount, exportPlatform) Then
                        oneUser = exportPlatform & "|" & accountAreaArr(i) & "|" & oneAccount("user_name") & "|" & oneAccount("user_pwd")
                        Try
                            File.AppendAllText(exportFilePath, oneUser & vbCrLf)
                            Console.WriteLine("成功导出记录:" & oneUser)
                            tboxOutput.AppendText("成功导出记录:" & oneUser & vbCrLf)
                        Catch ex As Exception
                            MsgBox("导出账号错误!")
                            Exit Sub
                        End Try
                    Else
                        MsgBox("当前数据库中没有可用于该平台导出的账户! ")
                    End If
                    dbUpdateRecord(oneAccount("user_name"), oneAccount("platform"), "area", accountAreaArr(i))
                    oneAccount.Clear()  '移除用来获取单条账户信息的hashtable变量的所有记录
                Next
            Next
        Else
            MsgBox("请至少输入一个要导出账号所在的游戏区号!")
        End If

    End Sub

    Private Sub btnImportAccountPath_Click(sender As Object, e As EventArgs) Handles btnImportAccountPath.Click
        OpenFileDialogImportFile.ShowDialog()
        txtImportAccountPath.Text = OpenFileDialogImportFile.FileName
    End Sub

    Private Sub btnImportAccount_Click(sender As Object, e As EventArgs) Handles btnImportAccount.Click
        Dim accountFilePath As String
        Dim accountOneLine, oneAccount, accountArr, i
        accountFilePath = txtImportAccountPath.Text
        If accountFilePath <> "" Then
            accountArr = File.ReadAllLines(accountFilePath)
            For i = 0 To UBound(accountArr)
                accountOneLine = Split(accountArr(i), "|")
                If dbInsertRecord(accountOneLine(2), accountOneLine(3), accountOneLine(0), "", "", accountOneLine(1)) Then
                    tboxOutput.AppendText("导入账号:  " & accountArr(i) & "  成功!" & vbCrLf)
                Else
                    tboxOutput.AppendText("导入账号:  " & accountArr(i) & "  失败!" & vbCrLf)
                End If
                'If dbDeleteRecord(accountOneLine(2), accountOneLine(0)) Then     '此处是临时用来从数据库删除匹配指定文件中的账号
                'tboxOutput.AppendText("删除账号:  " & accountArr(i) & "  成功!" & vbCrLf)
                'Else
                'tboxOutput.AppendText("删除账号:  " & accountArr(i) & "  失败!" & vbCrLf)
                'End If
            Next
        Else
            MsgBox("请选择要导入账号的文件!")
        End If

    End Sub

    Private Sub copydata(x, y, value)
        '输入身份证名字
        dm.SetClipboard(value) ' 身份证名字放到剪切板,用来后面粘贴
        Lclick(x, y)
        backSpace()
        dm.Delay(500)
        dm.KeyDown(17)               '按下Ctrl键
        Delay(100)
        dm.KeyPress(86)               '键入V键
        Delay(100)
        dm.KeyUp(17)                  '松开 Ctrl键   完成CTRL+ V 粘贴过程
        dm.Delay(200)
    End Sub

    Private Function waitImg(ByVal imgName, ByRef x, ByRef y, Optional ByVal x1 = 0, Optional ByVal y1 = 0, Optional ByVal x2 = 0, Optional ByVal y2 = 0) As Boolean
        Dim i As Integer
        Dim dm_ret, imgx, imgy
        For i = 1 To 30
            Console.WriteLine("等待找图!" & imgName)
            If x1 <> 0 And x2 <> 0 And y1 <> 0 And y2 <> 0 Then
                dm_ret = dm.FindPic(x1, y1, x2, y2, imgName, "000000", 0.8, 0, imgx, imgy)
            Else
                dm_ret = dm.FindPic(0, 0, 1024, 768, imgName, "000000", 0.8, 0, imgx, imgy)
            End If
            If dm_ret <> -1 Then
                x = imgx
                y = imgy
                Console.WriteLine("找到图片: " & imgName)
                Return True
            End If
            dm.Delay(1000)
        Next
        Return False
    End Function

    Private Sub waitWebBrowserIsReady()
        Do
            Console.WriteLine("等待网页加载完成.....")
            dm.Delay(1000)
            Console.WriteLine("ReadyState=" & Form2.WebBrowser1.ReadyState & " Complete=" & WebBrowserReadyState.Complete)
            Console.WriteLine(Form2.WebBrowser1.ReadyState = WebBrowserReadyState.Complete)
        Loop Until Form2.WebBrowser1.ReadyState = WebBrowserReadyState.Complete
    End Sub

    Private Function setCookiePath(action As String) As Boolean
        'tSet = reg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", "Cookies")
        'tSet1 = REG.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", "Cache")
        'tSet2 = REG.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\MICROSOFT\INTERNET EXPLORER\MAIN", "Window Title")
        Dim reg As RegistryKey = Registry.CurrentUser
        Dim shellFolders As RegistryKey = reg.OpenSubKey("SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", True)
        Dim currentCookiePath As String
        Select Case action
            Case "new"
                shellFolders.SetValue("Cookies", newCookiePath)
                currentCookiePath = shellFolders.GetValue("Cookies")
                Console.WriteLine("修改以后的Cookies路径:" & currentCookiePath)
                If currentCookiePath = newCookiePath Then
                    Return True
                End If
            Case "restore"
                shellFolders.SetValue("Cookies", oldCookiePath)
                currentCookiePath = shellFolders.GetValue("Cookies")
                Console.WriteLine("恢复后的Cookies路径: " & currentCookiePath)
                If currentCookiePath = oldCookiePath Then
                    Return True
                End If
        End Select
        Return False
    End Function


    Private Function deleteFiles(filePath As String, searchOption As String) As Boolean
        Try
            For Each foundFile As String In My.Computer.FileSystem.GetFiles(filePath, FileIO.SearchOption.SearchTopLevelOnly, searchOption)
                Console.WriteLine("删除文件　: " & foundFile)
                File.Delete(foundFile)
                Return True
            Next
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            Return False
        End Try
        Return False
    End Function

    Private Function login37wan(userName, userPwd, gameArea) As Boolean
        Dim dm_login, loginX, loginY, dm_logout, logoutX, logoutY
        For i As Integer = 1 To 20
            dm.Delay(500)
            dm_login = dm.FindPic(0, 0, 1024, 768, "37wan微端登录.bmp", "000000", 0.8, 0, loginX, loginY)
            Console.WriteLine("登录按钮坐标: " & dm_login & " " & loginX & " " & loginY)
            If dm_login <> -1 Then
                copydata(585, 140, userName)
                dm.Delay(200)
                copydata(585, 180, userPwd)
                dm.Delay(200)
                Lclick(loginX + 5, loginY + 5)
                dm.Delay(200)
                Return True
            Else
                dm_logout = dm.FindPic(0, 0, 1024, 768, "37wan注销.bmp", "000000", 0.8, 0, logoutX, logoutY)
                Console.WriteLine("注销按钮坐标: " & dm_logout & " " & logoutX & " " & logoutY)
                If dm_logout <> -1 Then
                    Lclick(logoutX + 2, logoutY + 2)
                    dm.Delay(500)
                End If
            End If
            dm.Delay(500)
        Next
        Return False
    End Function

    Private Function getChromeHwnd() As Long
        Dim hwnd
        hwnd = dm.FindWindowSuper("打开新的标签页 - Google Chrome", 0, 0, "Chrome_WidgetWin_1", 2, 0)
        If hwnd <> 0 Then     '检查chrome是否打开,
            Console.WriteLine(hwnd)
        Else
            'dm.RunApp("chrome.exe", 1)
            Shell(chromePath, AppWinStyle.NormalNoFocus)
            For i = 1 To 10
                dm.Delay(1000)
                hwnd = dm.FindWindowSuper("打开新的标签页 - Google Chrome", 0, 0, "Chrome_WidgetWin_1", 2, 0)
                If hwnd <> 0 Then
                    Return hwnd
                End If
            Next
            If hwnd = 0 Then
                MsgBox("超过10秒未打开chrome, 请检查chrome是否正确安装")
                Return 0
            End If
        End If
    End Function

    Private Function huanziAfterEnterGame(ByRef count, ByRef countTotalUsers, ByRef countTotalDiamonds, ByVal userName, ByVal platform, ByVal yOffset) As Boolean
        'yOffset 表示有些平台的客户端最上面会多出一个菜单条出来,此时相对默认没有多出来的平台Y坐标的偏移量,比如37wan多了15像素的菜单栏, 
        Dim dm_huodong, huodongX, huodongY
        Dim loopCount As Integer = 0
        Console.WriteLine("成功进入游戏!")
        dm_huodong = dm.FindPic(0, 0, 1024, 768, "大天使开服活动.bmp", "000000", 0.7, 0, huodongX, huodongY)
        Console.WriteLine("开服活动: " & dm_huodong & " " & huodongX & " " & huodongY)
        If dm_huodong <> -1 Then  '如果当前账号还有开服活动的话
            'Lclick(600, 190)  '点击开服活动按钮
            Lclick(huodongX + 3, huodongY + 3)
            dm.Delay(1500)
            'dm_store = dm.FindPic(0, 0, 1024, 768, "大天使随身商店.bmp", "000000", 0.8, 0, storeX, storeY)
            ' If dm_store <> -1 Then  '看看是不是打开了随身商店
            Lclick(1009, 540)
            'dm.Delay(200)
            'End If
            Dim smButtonColor, lhButtonColor As String
            Do
                loopCount = loopCount + 1
                smButtonColor = dm.GetColor(800, 500 + yOffset)  '换取生命宝石按钮的颜色, 能换是 71280c, 不能换是 2d2d2d
                dm.Delay(200)
                '如果领取宝石的按钮所获取的颜色不是 71280c 或者不是 2d2d2d ,说明被别的窗口挡住了, 关闭这个窗口
                If smButtonColor <> "71280c" Or smButtonColor <> "2d2d2d" Or lhButtonColor <> "71280c" Or lhButtonColor <> "2d2d2d" Then
                    Lclick(1009, 544)
                    dm.Delay(100)
                    Lclick(1005, 540)
                End If
                If smButtonColor = "71280c" Then
                    Lclick(800, 500 + yOffset) : dm.Delay(1)
                    count = count + 1
                    Console.WriteLine("领取生命宝石1一个!")
                End If
                lhButtonColor = dm.GetColor(800, 582 + yOffset)  '换取灵魂宝石按钮的颜色, 能换是71280c,不能换2d2d2d
                dm.Delay(200)
                If lhButtonColor = "71280c" Then
                    Lclick(800, 582 + yOffset) : dm.Delay(1)
                    count = count + 1
                    Console.WriteLine("领取灵魂宝石1一个!")
                    dm.Delay(3000)
                End If
                Console.WriteLine("领取生命宝石按钮颜色: " & smButtonColor & "领取灵魂宝石按钮的颜色: " & lhButtonColor)
            Loop Until (smButtonColor = "2d2d2d" And lhButtonColor = "2d2d2d") Or loopCount > 100   '领取宝石结束

            If loopCount > 100 Then
                Console.WriteLine("领取宝石超时! 请检查领取宝石按钮的颜色!或者背包是否已满!")
            Else
                Console.WriteLine("账号: " & userName & " 总共领取宝石数量：" & count)
            End If
        Else
            Console.WriteLine("当前账号: " & userName & " 已经不能领取开服活动奖励!")
            tboxGameAssistOutput.AppendText("当前账号: " & userName & " 已经不能领取开服活动奖励!" & vbCrLf)
        End If
        '成功登录游戏后, 不管当前账号是否换了宝石,都将账号状态改成已经换取宝石
        If dbUpdateRecord(userName, platform, "huanzi", "finish") Then
            Console.WriteLine("换字成功!")
            tboxGameAssistOutput.AppendText("当前账号: " & userName & " 总共换取宝石:" & count & vbCrLf)
            '只要当前账户换字状态成功更新 , ,则本次累计成功换取宝石用户数加1
            countTotalUsers = countTotalUsers + 1
            countTotalDiamonds = countTotalDiamonds + count  '累加本次总共换取宝石数量
            Return True
        Else
            Return False
            Console.WriteLine("当前账号: " & userName & "换字失败!")
            tboxGameAssistOutput.AppendText("当前账号: " & userName & "换字失败!" & vbCrLf)
        End If
        Return False
    End Function

    Private Function huanziHuoDong() As Boolean
        Dim selectPlatform
        Dim findUser As New Hashtable
        Dim selectUsers As ArrayList
        Dim userName, userPwd, gameArea, platform, huanzi As String
        Dim hwnd, dm_ret, imgx, imgy, x, y
        Dim datianshiHwnd As IntPtr
        Dim countTotalUsers As Integer = 0, countTotalDiamonds As Integer = 0
        datianshiHwnd = Me.Handle()
        selectPlatform = cbxSelectPlatform.GetItemText(cbxSelectPlatform.SelectedItem)

        If dbGetMultiUser(selectUsers, selectPlatform, "*", "") Then   '找到查询出所选平台下的所有游戏区的账号
            Select Case selectPlatform
                Case "360"
                    hwnd = getChromeHwnd()  '找到chrom句柄
                    dm_ret = dm.UnBindWindow()  '先解除dm窗口绑定
                    dm.Delay(1000)
                    'dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows3", "windows", "", 0)  '后台绑定chrome窗口
                    dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows", "dx.keypad.input.lock.api|dx.keypad.state.api|dx.keypad.api|dx.keypad.raw.input", "dx.public.active.api2", 0)
                    dm.Delay(1000)
                    If dm_ret = 1 Then
                        dm_ret = dm.SetWindowSize(hwnd, SetFindWidth, SetFindHeight)
                        If dm_ret = 0 Then
                            MsgBox("设置chrome窗口大小失败!请检查设置!")
                            Exit Function
                        End If
                    Else
                        Console.WriteLine("大漠绑定结果: " & dm_ret & " 大漠绑定失败代码: " & dm.GetLastError)
                        MsgBox("窗口绑定失败!")
                        Exit Function
                    End If
                    For Each findUser In selectUsers
                        Dim dm_login, loginX, loginY, dm_touxiang, touxiangX, touxiangY, dm_gaming, dm_huanzi, dm_store, gameX, gameY, huanziX, huanziY, storeX, storeY
                        Dim dm_huodong, huodongX, huodongY, dm_popup, popupX, popupY
                        Dim count As Integer = 0
                        Dim loopCount As Integer = 0
                        Dim huanziState As String = "失败!"
                        userName = findUser("user_name") : userPwd = findUser("user_pwd") : gameArea = findUser("area") : platform = findUser("platform") : huanzi = findUser("huanzi")
                        If huanzi = "" Then
                            Lclick(846, 57)    '移动到地址输入栏
                            dm.Delay(200)
                            dm.KeyPressStr("wan.360.cn", 10)   '输入选中平台的登录
                            dm.KeyPress(13)
                            dm.Delay(1000)

                            dm_login = waitImg("360登录.bmp", loginX, loginY)  '找图,等首页登录按钮刷新出来
                            Console.WriteLine("首页登录按钮坐标:" & dm_ret & "," & loginX & "," & loginY)
                            dm.Delay(200)
                            If dm_login Then
                                Dim dm_yzm, inputx, inputy, yzmx, yzmy, dm_err, errx, erry
                                Dim yzmErr As Integer = 0
                                dm_yzm = -1
                                Do
                                    If dm_yzm = -1 Then
                                        copydata(215, 188, userName)  '输入用户名
                                        dm.Delay(200)
                                        Lclick(214, 227)
                                        copydata(214, 227, userPwd) '输入密码
                                        dm.Delay(200)
                                    End If
                                    Lclick(100, 295)   '点击登录按钮
                                    dm.Delay(500)
                                    dm_err = dm.FindPic(0, 0, 1024, 768, "360账号密码输入错误.bmp", "000000", 0.8, 0, errx, erry)
                                    dm.Delay(200)
                                    Console.WriteLine("账号密码错误坐标:" & dm_err & "," & errx & "," & erry)
                                    If dm_err <> -1 Then  '如果出现账号密码错误,则直接跳过此账号
                                        Console.WriteLine("账号密码错误,跳过此账号!")
                                        Exit Do
                                    End If
                                    dm_yzm = dm.FindPic(0, 0, 1024, 768, "360请正确填写注册码.bmp|360验证码错误.bmp|360请输入验证码.bmp|360登录验证码错误.bmp", "000000", 0.8, 0, yzmx, yzmy)
                                    dm.Delay(200)
                                    '如果验证码错误的话或者没有输入验证码
                                    If dm_yzm <> -1 Then
                                        For i As Integer = 1 To Random(1, 3)  '连续换3张打码的图片, 经常第一章图片很难识别
                                            Lclick(215, 288)
                                            dm.Delay(100)
                                        Next
                                        dm.Delay(2000)
                                        dm.CaptureJpg(129, 276, 190, 304, imgPath & "login_360yzm.jpg", 50)  '将验证码截图置于imgPath目录下
                                        Dim yzm As String = dama2(imgPath & "login_360yzm.jpg")
                                        Lclick(121, 290)
                                        backSpace() : dm.Delay(200)
                                        dm.KeyPressStr(yzm, 20)
                                        dm.Delay(200)
                                    End If
                                    '出现验证码和不出现验证码按钮位置不同
                                    If dm_yzm = -1 Then
                                        Lclick(100, 295)
                                    Else
                                        Lclick(100, 334)
                                    End If

                                    dm_popup = dm.FindPic(0, 0, 240, 40, "chrome新开窗口按钮.bmp", "000000", 0.8, 0, popupX, popupY)
                                    If dm_popup = -1 Then
                                        For i As Integer = 1 To 4
                                            Lclick(382, 29)
                                            'dm_popup = dm.FindPic(0, 0, 240, 40, "chrome新开窗口按钮.bmp", "000000", 0.8, 0, popupX, popupY)
                                            dm.Delay(500)
                                        Next
                                    Else
                                        dm.Delay(1000)
                                    End If
                                    dm_touxiang = dm.FindPic(0, 0, 1024, 768, "360默认头像.bmp", "000000", 0.8, 0, yzmx, yzmy)
                                    ' dm_ret = findImg("360免费注册.bmp", imgx, imgy)  '找图 马上注册页面
                                Loop Until dm_touxiang <> -1  '如果验证码一直存在,尝试输入验证码登录,直到登陆成功

                                Console.WriteLine("默认头像坐标:" & dm_touxiang & "," & touxiangX & "," & touxiangY)
                                If dm_touxiang <> -1 Then   '登录成功
                                    Lclick(846, 57)
                                    dm.Delay(200)
                                    backSpace()
                                    dm.Delay(200)
                                    dm.KeyPressStr("dtszj.wan.360.cn/game_login.php?server_id=S" & gameArea, 10)
                                    dm.KeyPress(13)
                                    dm.Delay(1000)
                                    '登录成功以后要等待游戏加载,这里设置的是等待30秒
                                    For i = 1 To 30
                                        dm_gaming = dm.FindPic(0, 0, 1024, 768, "大天使世界地图.bmp", "000000", 0.8, 0, gameX, gameY) '游戏里的地图是图片是一样的
                                        If dm_gaming <> -1 Then
                                            Exit For
                                        End If
                                        dm.Delay(1000)
                                    Next
                                    If dm_gaming <> -1 Then
                                        If huanziAfterEnterGame(count, countTotalUsers, countTotalDiamonds, userName, platform, 0) Then
                                            huanziState = "成功"
                                        End If
                                    Else
                                        Console.WriteLine("当前账号: " & userName & "进入游戏超时!")
                                        tboxGameAssistOutput.AppendText("当前账号: " & userName & "进入游戏超时!" & vbCrLf)
                                    End If

                                Else
                                    Console.WriteLine("账号: " & userName & " 登录超时!")
                                End If
                            Else
                                Console.WriteLine("找不到登录按钮!")
                            End If
                            '清除浏览器Cookies
                            clearChrome()
                            'Exit Sub  '调试用,测试一个账号就结束
                        End If
                        dm_login = Nothing : loginX = Nothing : loginY = Nothing : dm_touxiang = Nothing : touxiangX = Nothing : touxiangY = Nothing
                        dm_gaming = Nothing : dm_huanzi = Nothing : dm_store = Nothing : gameX = Nothing : gameY = Nothing : huanziX = Nothing : huanziY = Nothing
                        dm_store = Nothing : storeX = Nothing : storeY = Nothing : dm_huodong = Nothing : huodongX = Nothing : huodongY = Nothing
                        dm_popup = Nothing : popupX = Nothing : popupY = Nothing
                    Next

                Case "37wan"
                    hwnd = getChromeHwnd()  '找到chrom句柄
                    dm_ret = dm.UnBindWindow()  '先解除dm窗口绑定\
                    'dm.SetWindowState(datianshiHwnd, 1)
                    dm.Delay(500)
                    'dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows3", "windows", "", 0)  '后台绑定chrome窗口
                    dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows", "dx.keypad.input.lock.api|dx.keypad.state.api|dx.keypad.api|dx.keypad.raw.input", "dx.public.active.api2", 0)
                    dm.Delay(1000)
                    If dm_ret = 1 Then
                        dm_ret = dm.SetWindowSize(hwnd, SetFindWidth, SetFindHeight)
                        If dm_ret = 0 Then
                            MsgBox("设置chrome窗口大小失败!请检查设置!")
                            Exit Function
                        End If
                    Else
                        Console.WriteLine("大漠绑定结果: " & dm_ret & " 大漠绑定失败代码: " & dm.GetLastError)
                        MsgBox("窗口绑定失败!")
                        Exit Function
                    End If
                    For Each findUser In selectUsers
                        Dim dm_login, loginX, loginY, dm_gaming, dm_huanzi, dm_store, gameX, gameY, huanziX, huanziY, storeX, storeY
                        Dim dm_huodong, huodongX, huodongY, dm_popup, popupX, popupY
                        Dim count As Integer = 0
                        Dim loopCount As Integer = 0
                        Dim huanziState As String = "失败!"

                        userName = findUser("user_name") : userPwd = findUser("user_pwd") : gameArea = findUser("area") : platform = findUser("platform") : huanzi = findUser("huanzi")

                        If huanzi = "" Then
                            copydata(846, 57, "gameapp.37.com/controller/client.php?game_id=237") '输入选中平台的登录
                            dm.Delay(100)
                            dm.KeyPress(13)
                            dm.Delay(1000)
                            dm_login = waitImg("37wan微端登录.bmp", loginX, loginY)  '找图,等首页登录按钮刷新出来
                            Console.WriteLine("37wan微端登录按钮坐标:" & dm_ret & "," & loginX & "," & loginY)
                            dm.Delay(200)

                            If login37wan(userName, userPwd, gameArea) Then
                                Console.WriteLine("游戏登录成功!")
                                Console.WriteLine("账号平台:" & platform & " 游戏区号: " & gameArea & " 账户名: " & userName & " 账号密码:" & userPwd & vbCrLf)
                                If waitImg("37wan更多服务器.bmp", x, y) Then
                                    Console.WriteLine("登录到选择服务器界面!")
                                Else
                                    Console.WriteLine("登录错误, 请检查密码是否正确!")
                                    Exit Select
                                End If

                                copydata(846, 57, "game.37.com/play.php?game_id=237&sid=" & gameArea)
                                dm.Delay(100)
                                dm.KeyPress(13)
                                dm.Delay(1000)

                                For i = 1 To 30
                                    dm_gaming = dm.FindPic(0, 0, 1024, 768, "37wan世界地图.bmp", "000000", 0.8, 0, gameX, gameY)
                                    If dm_gaming <> -1 Then
                                        Exit For
                                    Else
                                        dm.Delay(100)
                                        Dim dm_confirm, confirmX, confirmY
                                        dm_confirm = dm.FindPic(0, 0, 1024, 768, "37wan确定进入.bmp", "000000", 0.8, 0, confirmX, confirmY)
                                        Console.WriteLine("确认进入游戏验证码:" & dm_confirm & " " & confirmX & " " & confirmY)
                                        If dm_confirm <> -1 Then
                                            dm.CaptureJpg(225, 475, 305, 506, imgPath & "login_37wanyzm.jpg", 50)  '将验证码截图置于imgPath目录下
                                            Dim yzm As String = dama2(imgPath & "login_37wanyzm.jpg")
                                            Lclick(300, 460)   '点击验证码输入框
                                            backSpace() : dm.Delay(200)
                                            dm.KeyPressStr(yzm, 20)
                                            dm.Delay(200)
                                            Lclick(confirmX + 2, confirmY + 2)  '点击确定进入按钮
                                            dm.Delay(1000)
                                        End If
                                        Dim dm_list, listX, listY
                                        dm_list = dm.FindPic(0, 0, 1024, 768, "37wan快速进入.bmp", "000000", 0.8, 0, listX, listY)
                                        Console.WriteLine("登录过程中正确输入验证码后返回快速进入列表页: " & dm_list & "  " & listX & "  " & listY)
                                        If dm_list <> -1 Then
                                            copydata(846, 57, "game.37.com/play.php?game_id=237&sid=" & gameArea)
                                            dm.Delay(100)
                                            dm.KeyPress(13)
                                            dm.Delay(1000)
                                        End If
                                        dm_confirm = Nothing : confirmX = Nothing : confirmY = Nothing
                                        dm_list = Nothing : listX = Nothing : listY = Nothing
                                    End If
                                    Console.WriteLine("等待进入游戏!" & i & " 秒")
                                    dm.Delay(900)
                                Next

                                If dm_gaming <> -1 Then  '成功进入游戏后,调用进入游戏后换字函数
                                    'huanziAfterEnterGame函数中 参数: 15 表示37平台进入游戏后,游戏窗口最上面多出一条15像素的菜单栏
                                    If huanziAfterEnterGame(count, countTotalUsers, countTotalDiamonds, userName, platform, 15) Then
                                        huanziState = "成功"
                                    End If
                                Else
                                    Console.WriteLine("当前账号: " & userName & "进入游戏超时!")
                                    tboxGameAssistOutput.AppendText("当前账号: " & userName & "进入游戏超时!" & vbCrLf)
                                End If

                            Else
                                Console.WriteLine("当前账号: " & userName & "游戏登录失败!")
                            End If
                            '清除浏览器Cookies
                            clearChrome()
                            dm.Delay(500)
                            tboxGameAssistOutput.AppendText("账号平台:" & platform & " 游戏区号: " & gameArea & " 账户名: " & userName & " 账号密码:" & userPwd & "  更新数据库" & huanziState & vbCrLf)
                        End If
                        '将变量都释放,以防大漠获取不到值
                        dm_login = Nothing : loginX = Nothing : loginY = Nothing : dm_gaming = Nothing : dm_huanzi = Nothing : dm_store = Nothing : gameX = Nothing
                        gameY = Nothing : huanziX = Nothing : huanziY = Nothing : dm_popup = Nothing : popupX = Nothing : popupY = Nothing
                        dm_store = Nothing : storeX = Nothing : storeY = Nothing : dm_huodong = Nothing : huodongX = Nothing : huodongY = Nothing
                    Next

                Case "百度"
                    hwnd = getChromeHwnd()  '找到chrom句柄
                    dm_ret = dm.UnBindWindow()  '先解除dm窗口绑定
                    dm.Delay(1000)
                    'dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows3", "windows", "", 0)  '后台绑定chrome窗口
                    dm_ret = dm.BindWindowEx(hwnd, "gdi", "windows", "dx.keypad.input.lock.api|dx.keypad.state.api|dx.keypad.api|dx.keypad.raw.input", "dx.public.active.api2", 0)
                    dm.Delay(1000)
                    If dm_ret = 1 Then
                        dm_ret = dm.SetWindowSize(hwnd, SetFindWidth, SetFindHeight)
                        If dm_ret = 0 Then
                            MsgBox("设置chrome窗口大小失败!请检查设置!")
                            Exit Function
                        End If
                    Else
                        Console.WriteLine("大漠绑定结果: " & dm_ret & " 大漠绑定失败代码: " & dm.GetLastError)
                        MsgBox("窗口绑定失败!")
                        Exit Function
                    End If
                    For Each findUser In selectUsers
                        Dim dm_login, loginX, loginY, dm_touxiang, touxiangX, touxiangY, dm_gaming, dm_huanzi, dm_store, gameX, gameY, huanziX, huanziY, storeX, storeY
                        Dim dm_huodong, huodongX, huodongY, dm_popup, popupX, popupY
                        Dim count As Integer = 0
                        Dim loopCount As Integer = 0
                        Dim huanziState As String = "失败!"
                        userName = findUser("user_name") : userPwd = findUser("user_pwd") : gameArea = findUser("area") : platform = findUser("platform") : huanzi = findUser("huanzi")
                        If huanzi = "" Then
                            '在地址栏输入百度平台的登陆地址
                            copydata(846, 57, "http://youxi.baidu.com/login.xhtml?toURL=http%3A%2F%2Fyouxi.baidu.com%2Fuser_center.xhtml")
                            dm.KeyPress(13)
                            dm.Delay(1000)

                            dm_login = waitImg("百度首页登录按钮.bmp", loginX, loginY)  '找图,等首页登录按钮刷新出来
                            Console.WriteLine("首页登录按钮坐标:" & dm_ret & "," & loginX & "," & loginY)
                            dm.Delay(200)
                            If dm_login Then
                                Dim dm_yzm, inputx, inputy, yzmx, yzmy, dm_err, errx, erry
                                Dim yzmErr As Integer = 0
                                dm_yzm = -1
                                Do
                                    If dm_yzm = -1 Then
                                        copydata(380, 290, userName)  '输入用户名
                                        dm.Delay(200)
                                        Lclick(380, 360)
                                        copydata(380, 360, userPwd) '输入密码
                                        dm.Delay(200)
                                    End If
                                    Lclick(230, 465)   '点击登录按钮
                                    dm.Delay(500)
                                    dm_err = dm.FindPic(0, 0, 1024, 768, "360账号密码输入错误.bmp", "000000", 0.8, 0, errx, erry)
                                    dm.Delay(200)
                                    Console.WriteLine("账号密码错误坐标:" & dm_err & "," & errx & "," & erry)
                                    If dm_err <> -1 Then  '如果出现账号密码错误,则直接跳过此账号
                                        Console.WriteLine("账号密码错误,跳过此账号!")
                                        Exit Do
                                    End If
                                    dm_yzm = dm.FindPic(0, 0, 1024, 768, "百度登录验证码错误.bmp|百度登录输入验证码.bmp", "000000", 0.8, 0, yzmx, yzmy)
                                    dm.Delay(200)
                                    '如果验证码错误的话或者没有输入验证码
                                    If dm_yzm <> -1 Then
                                        For i As Integer = 1 To Random(1, 3)  '连续换3张打码的图片, 经常第一章图片很难识别
                                            Lclick(320, 390)
                                            dm.Delay(100)
                                        Next
                                        dm.Delay(2000)
                                        dm.CaptureJpg(198, 372, 285, 410, imgPath & "login_baiduyzm.jpg", 50)  '将验证码截图置于imgPath目录下
                                        Dim yzm As String = dama2(imgPath & "login_baiduyzm.jpg")
                                        Lclick(190, 395)  '单击验证码输入框
                                        backSpace() : dm.Delay(200)
                                        dm.KeyPressStr(yzm, 20)
                                        dm.Delay(200)
                                    End If
                                    '出现验证码和不出现验证码按钮位置不同
                                    If dm_yzm = -1 Then
                                        Lclick(230, 465)
                                    Else
                                        Lclick(230, 390)
                                    End If

                                    dm_popup = dm.FindPic(0, 0, 240, 40, "chrome新开窗口按钮.bmp", "000000", 0.8, 0, popupX, popupY)
                                    If dm_popup = -1 Then
                                        For i As Integer = 1 To 4
                                            Lclick(382, 29)
                                            'dm_popup = dm.FindPic(0, 0, 240, 40, "chrome新开窗口按钮.bmp", "000000", 0.8, 0, popupX, popupY)
                                            dm.Delay(500)
                                        Next
                                    Else
                                        dm.Delay(1000)
                                    End If
                                    dm_touxiang = dm.FindPic(0, 0, 1024, 768, "百度注册后头像.bmp|百度登录后头像.bmp", "000000", 0.8, 0, yzmx, yzmy)
                                    ' dm_ret = findImg("360免费注册.bmp", imgx, imgy)  '找图 马上注册页面
                                Loop Until dm_touxiang <> -1  '如果验证码一直存在,尝试输入验证码登录,直到登陆成功

                                Console.WriteLine("默认头像坐标:" & dm_touxiang & "," & touxiangX & "," & touxiangY)
                                If dm_touxiang <> -1 Then   '登录成功
                                    copydata(846, 57, "youxi.baidu.com/login_game_for_general.xhtml?id=842&serverId=S" & gameArea)
                                    dm.KeyPress(13)
                                    dm.Delay(1000)
                                    '登录成功以后要等待游戏加载,这里设置的是等待30秒
                                    For i = 1 To 30
                                        dm_gaming = dm.FindPic(0, 0, 1024, 768, "大天使世界地图.bmp", "000000", 0.8, 0, gameX, gameY) '游戏里的地图是图片是一样的
                                        If dm_gaming <> -1 Then
                                            Exit For
                                        End If
                                        dm.Delay(1000)
                                    Next
                                    If dm_gaming <> -1 Then
                                        If huanziAfterEnterGame(count, countTotalUsers, countTotalDiamonds, userName, platform, -17) Then
                                            huanziState = "成功"
                                        End If
                                    Else
                                        Console.WriteLine("当前账号: " & userName & "进入游戏超时!")
                                        tboxGameAssistOutput.AppendText("当前账号: " & userName & "进入游戏超时!" & vbCrLf)
                                    End If

                                Else
                                    Console.WriteLine("账号: " & userName & " 登录超时!")
                                End If
                            Else
                                Console.WriteLine("找不到登录按钮!")
                            End If
                            '清除浏览器Cookies
                            clearChrome()
                            'Exit Sub  '调试用,测试一个账号就结束
                        End If
                        dm_login = Nothing : loginX = Nothing : loginY = Nothing : dm_touxiang = Nothing : touxiangX = Nothing : touxiangY = Nothing
                        dm_gaming = Nothing : dm_huanzi = Nothing : dm_store = Nothing : gameX = Nothing : gameY = Nothing : huanziX = Nothing : huanziY = Nothing
                        dm_store = Nothing : storeX = Nothing : storeY = Nothing : dm_huodong = Nothing : huodongX = Nothing : huodongY = Nothing
                        dm_popup = Nothing : popupX = Nothing : popupY = Nothing
                    Next

            End Select

            tboxGameAssistOutput.AppendText("本次总计成功换字用户: " & countTotalUsers & "    本次总共换取宝石数量: " & countTotalDiamonds)
            tboxGameAssistOutput.AppendText("本次总计换字失败账号数量:" & selectUsers.Count - countTotalUsers)
            If countTotalUsers = selectUsers.Count Then
                Return True
            Else
                Return False
            End If
            'Console.WriteLine("总共找到: " & selectUsers.Count & " 条记录!")
        End If
        Return True
    End Function

    Private Sub btnHuanZi_Click(sender As Object, e As EventArgs) Handles btnHuanZi.Click
        Dim success As Boolean = False
        Do
            success = huanziHuoDong()
        Loop Until success

    End Sub


    'Private Shared Function gettxt(ByVal port As Integer, ByVal wait As Integer, ByVal _date As Long, ByVal _time As Long, ByVal filename As String) As Integer
    'End Function

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        Dim tSet As String, tSet1 As String, tSet2 As String, tsetOld As String
        Dim reg As RegistryKey = Registry.CurrentUser
        Dim shellFolders As RegistryKey = reg.OpenSubKey("SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", True)
        If Not (Directory.Exists(rootPath & "temp")) Then
            Directory.CreateDirectory(rootPath & "temp")
        End If

        tsetOld = shellFolders.GetValue("Cookies")
        shellFolders.SetValue("Cookies", rootPath & "temp")
        tSet = shellFolders.GetValue("Cookies")
        Console.WriteLine("修改以后的Cookies路径:" & tSet)
        If deleteFiles(newCookiePath, "*.txt") Then
            Console.WriteLine("删除Cookies文件成功!")
        End If
        shellFolders.SetValue("Cookies", tsetOld)
        tSet = shellFolders.GetValue("Cookies")
        Console.WriteLine("恢复后的Cookies路径: " & tSet)
        If InternetSetOption(IntPtr.Zero, INTERNET_OPTION_END_BROWSER_SESSION, IntPtr.Zero, 0) Then
            Console.WriteLine("清除session成功!")
        End If
        myMsgBox(0, "这就是用 DllImport 调用 DLL 弹出的提示框哦！ ", " 挑战杯 ", 48)
        'tSet = reg.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", "Cookies")
        'tSet1 = REG.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\User Shell Folders", "Cache")
        'tSet2 = REG.GetRegistryValue(HKEY_CURRENT_USER, "SOFTWARE\MICROSOFT\INTERNET EXPLORER\MAIN", "Window Title")
    End Sub


    Private Sub btnSetChromePath_Click(sender As Object, e As EventArgs) Handles btnSetChromePath.Click
        OpenFileDialogChromePath.ShowDialog()
        txtImportAccountPath.Text = OpenFileDialogChromePath.FileName
    End Sub

    Private Sub btnSelectResetFile_Click(sender As Object, e As EventArgs) Handles btnSelectResetFile.Click
        OpenFileDialogResetFile.ShowDialog()
        txtResetAreaFilePath.Text = OpenFileDialogResetFile.FileName
    End Sub

    Private Sub btnResetArea_Click(sender As Object, e As EventArgs) Handles btnResetArea.Click
        Dim accountFilePath As String
        Dim accountOneLine, oneAccount, accountArr, i
        accountFilePath = txtResetAreaFilePath.Text
        If accountFilePath <> "" Then
            accountArr = File.ReadAllLines(accountFilePath)
            For i = 0 To UBound(accountArr)
                accountOneLine = Split(accountArr(i), "|")
                If dbUpdateRecord(accountOneLine(2), accountOneLine(0), "area", "") Then     '此处是临时用来从数据库删除匹配指定文件中的账号
                    tboxDbOutput.AppendText("重置账号:  " & accountArr(i) & "  游戏区号成功!" & vbCrLf)
                Else
                    tboxDbOutput.AppendText("重置账号:  " & accountArr(i) & "  游戏区号失败!" & vbCrLf)
                End If
            Next
        Else
            MsgBox("请选择要重置游戏区号的账号文件!")
        End If
    End Sub

    Private Sub btnSelectExportIniPath_Click(sender As Object, e As EventArgs) Handles btnSelectExportIniPath.Click
        OpenFileDialogExportIniPath.ShowDialog()
        txtExportIniPath.Text = OpenFileDialogExportIniPath.FileName
    End Sub


    Private Sub btnExportByIni_Click(sender As Object, e As EventArgs) Handles btnExportByIni.Click
        Dim oneAccount As New Hashtable
        Dim accountAreaArr, exportNum, exportPlatform, iniArr, iniOnelineArr, pcName
        Dim areaCounts As Integer, i As Integer, groupCount As Integer, j As Integer
        Dim exportFilePath As String, exportBasePath As String
        Dim oneUser As String

        If Not (Directory.Exists(rootPath & "exportfile")) Then
            Directory.CreateDirectory(rootPath & "exportfile")
        End If
        exportBasePath = rootPath & "exportfile\" & Now.ToString("yMMdd")
        If Not (Directory.Exists(rootPath & "exportfile\" & Now.ToString("yMMdd"))) Then
            Directory.CreateDirectory(exportBasePath)
        End If

        If txtExportIniPath.Text <> "" Then
            iniArr = File.ReadAllLines(txtExportIniPath.Text)
            For pcNum As Integer = 0 To UBound(iniArr)
                '将配置文件中的单条记录拆分成不同的变量
                iniOnelineArr = Split(iniArr(pcNum), "|")
                pcName = iniOnelineArr(0) : exportPlatform = iniOnelineArr(1)
                accountAreaArr = Split(iniOnelineArr(2), ",")  '多个挂机区号用 " , " 分割, accountAreaArr 表示区号数组
                exportNum = CInt(iniOnelineArr(3)) '导出账号数量
                groupCount = exportNum / (UBound(accountAreaArr) + 1)  'groupCount表示如果存在多个区每个区挂机的数量

                Console.WriteLine("导出平台:" & exportPlatform & "每个游戏区账号数:" & groupCount)
                exportFilePath = exportBasePath & "\" & pcName & ".txt"
                tboxDbOutput.AppendText("导出文件路径: " & exportFilePath)
                If Not (File.Exists(exportFilePath)) Then
                    Dim fs As FileStream = File.Create(exportFilePath)   '创建导出文件
                    'Dim info As Byte() = New UTF8Encoding(True).GetBytes("This is some text in the file.")  '得先做转换
                    'fs.Write(info, 0, info.Length)        '这是filestrem类写入内容的方法
                    fs.Close()   '通过file.create方法创建的文件默认是打开的,如果想让别的程序能操作就得先关闭文件
                End If
                For i = 0 To UBound(accountAreaArr)
                    For j = 1 To groupCount

                        If dbExportOneAccount(oneAccount, exportPlatform) Then
                            oneUser = exportPlatform & "|" & accountAreaArr(i) & "|" & oneAccount("user_name") & "|" & oneAccount("user_pwd")
                            Try
                                File.AppendAllText(exportFilePath, oneUser & vbCrLf)
                                Console.WriteLine("成功导出记录:" & oneUser)
                                tboxDbOutput.AppendText("成功导出记录:" & oneUser & vbCrLf)
                            Catch ex As Exception
                                MsgBox("导出账号错误!")
                                Exit Sub
                            End Try
                        Else
                            MsgBox("当前数据库中没有可用于该平台导出的账户! ")
                        End If
                        dbUpdateRecord(oneAccount("user_name"), oneAccount("platform"), "area", accountAreaArr(i))
                        oneAccount.Clear()  '移除用来获取单条账户信息的hashtable变量的所有记录
                    Next
                Next
            Next  '循环取出配置文件中的每条记录结束
        Else
            MsgBox("请选则导出配置文件!")
        End If
    End Sub


    Private Sub btnCheckAccount_Click(sender As Object, e As EventArgs) Handles btnCheckAccount.Click
        Dim selectPlatform, platform
        Dim findUser As New Hashtable
        Dim selectUsers As ArrayList
        Dim userName, userPwd
        Dim loginSuccess As Boolean

        For Each selectRadio As RadioButton In grpPlatform.Controls
            If selectRadio.Checked Then
                Select Case selectRadio.Text
                    Case "37wan"
                        If dbGetMultiUser(selectUsers, "37wan", "*", "*") Then
                            For Each findUser In selectUsers
                                loginSuccess = False
                                userName = findUser("user_name") : userPwd = findUser("user_pwd") : platform = findUser("platform")
                                For i As Integer = 1 To 3
                                    If login37Check(userName, userPwd, yzm91sn, imgPath) Then
                                        loginSuccess = True
                                        tboxOutput.AppendText("账号:" & userName & " " & userPwd & " " & platform & "  登录正常!" & vbCrLf)
                                        Console.WriteLine("账号:" & userName & " " & userPwd & " " & platform & "  登录正常!")
                                        Exit For
                                    End If
                                    ' dm.Delay(1000)
                                Next
                                If Not (loginSuccess) Then
                                    tboxDbOutput.AppendText("账号:" & userName & " " & userPwd & " " & platform & "  登录异常!" & vbCrLf)
                                End If
                            Next
                        End If
                End Select
            End If
        Next
    End Sub



    Private Sub btnSelectExchangeReadyFilePath_Click(sender As Object, e As EventArgs) Handles btnSelectExchangeReadyFilePath.Click
        OpenFileDialogReadyExchangeFile.ShowDialog()
        txtExchangeReadyFilePath.Text = OpenFileDialogReadyExchangeFile.FileName
    End Sub

    Private Sub btnImportExchangeReadyAccount_Click(sender As Object, e As EventArgs) Handles btnImportExchangeReadyAccount.Click
        Dim accountFilePath As String
        Dim accountArr, oneAccountArr, gameArr
        Dim accountInfo As Hashtable
        Dim platformArr, areaArr As ArrayList
        Dim userName, userPwd, gameArea, platform, exchangeStatus, sql As String
        accountFilePath = txtExchangeReadyFilePath.Text
        accountArr = File.ReadAllLines(accountFilePath)
        For i As Integer = 0 To UBound(accountArr)  '先将需要交易的账号 "exchange" 字段设置为 ready
            oneAccountArr = Split(accountArr(i), "|")
            userName = oneAccountArr(2) : userPwd = oneAccountArr(3) : gameArea = oneAccountArr(1) : platform = oneAccountArr(0)
            If dbGetAccountInfo(accountInfo, userName, platform) Then
                exchangeStatus = accountInfo("exchange")   '获取账号的 exchange字段值,
                If exchangeStatus = "" Or exchangeStatus = "finish" Then   '判断账号的exchange字段值, 只有当前字段值为空或者为finish时才需要导出, 否则说明此账号已经到出过
                    If dbUpdateRecord(userName, platform, "exchange", "ready") Then
                        tboxGameAssistOutput.AppendText("账号: " & userName & " " & platform & " " & gameArea & " 设置等待交易成功!" & vbCrLf)
                    Else
                        tboxGameAssistOutput.AppendText("账号: " & userName & " " & platform & " " & gameArea & " 设置等待交易失败!" & vbCrLf)
                    End If
                Else
                    tboxGameAssistOutput.AppendText("账号: " & userName & " " & platform & " " & gameArea & " 正在等待交易 !" & vbCrLf)
                End If
            Else
                tboxGameAssistOutput.AppendText("数据库中查询不到账号:　" & userName & " " & userPwd & " " & platform & " " & gameArea & vbCrLf)
            End If
        Next
        sql = "select distinct platform  from user_datianshi where exchange ='ready' "
        If dbGetMultiRecords(platformArr, sql) Then
            For Each record As Hashtable In platformArr
                Console.WriteLine(record("platform"))
            Next
        End If
    End Sub
End Class
